Github Code: Hoon0427/RPubs
File Download: Titanic Data
분석을 하기전에 당시의 시대 상황이 어떤지 파악해보자. 영화 타이타닉의 장면들을 가져와봤다. 장면들에서 볼수 있겠지만 우선 객실의 등급이 우선시 되는 시대였다. 1,2,3등급의 객실로 사람을 구분 짓고 보트에 탑승 할때도 되도록이면 1등급의 사람을 우선 태웠다. 심지어 영화내용에는 1등급의 사람들은 보트도 여유있게 탑승 한것처럼 표현을 하고 있더라. 그리고 나서 여자와 아이들을 먼저 태우려 하고, 결국 마지막에 죽는 사람들은 2,3등급 객실의 남자가 대부분 죽는것처럼 나온다. 캐글에서 받은 데이터도 실제로 이러한지 알아보면서 분석을 해보자.
library(tidyverse)
library(ggplot2)
library(plotly)
library(rpart)
library(rpart.plot)
library(caret)
library(e1071)
library(randomForest)
library(htmltools)
training_set <- read.csv("train.csv")
test_set <- read.csv("test.csv")
각각의 데이터를 파악해보자. 영화에 표현되었던 객실(Pclass), 성별(Sex), 나이(Age)
str(training_set)
## 'data.frame': 891 obs. of 12 variables:
## $ PassengerId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ Survived : int 0 1 1 1 0 0 0 0 1 1 ...
## $ Pclass : int 3 1 3 1 3 3 1 3 3 2 ...
## $ Name : Factor w/ 891 levels "Abbing, Mr. Anthony",..: 109 191 358 277 16 559 520 629 417 581 ...
## $ Sex : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
## $ Age : num 22 38 26 35 35 NA 54 2 27 14 ...
## $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...
## $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...
## $ Ticket : Factor w/ 681 levels "110152","110413",..: 524 597 670 50 473 276 86 396 345 133 ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Cabin : Factor w/ 148 levels "","A10","A14",..: 1 83 1 57 1 1 131 1 1 1 ...
## $ Embarked : Factor w/ 4 levels "","C","Q","S": 4 2 4 4 4 3 4 4 4 2 ...
# Train set cleansing
training_set$Pclass <- as.factor(training_set$Pclass)
training_set$Name <- as.character(training_set$Name)
training_set$Ticket <- as.character(training_set$Ticket)
training_set$Cabin <- as.character(training_set$Cabin)
# Test set cleansing
test_set$Pclass <- as.factor(test_set$Pclass)
test_set$Name <- as.character(test_set$Name)
test_set$Ticket <- as.character(test_set$Ticket)
test_set$Cabin <- as.character(test_set$Cabin)
test_set$Age[is.na(test_set$Age)] <- mean(test_set$Age, na.rm = T)
Summary() 함수를 사용해서 데이터의 요약정보를 불러오자.
summary(training_set)
## PassengerId Survived Pclass Name Sex
## Min. : 1.0 Min. :0.0000 1:216 Length:891 female:314
## 1st Qu.:223.5 1st Qu.:0.0000 2:184 Class :character male :577
## Median :446.0 Median :0.0000 3:491 Mode :character
## Mean :446.0 Mean :0.3838
## 3rd Qu.:668.5 3rd Qu.:1.0000
## Max. :891.0 Max. :1.0000
##
## Age SibSp Parch Ticket
## Min. : 0.42 Min. :0.000 Min. :0.0000 Length:891
## 1st Qu.:20.12 1st Qu.:0.000 1st Qu.:0.0000 Class :character
## Median :28.00 Median :0.000 Median :0.0000 Mode :character
## Mean :29.70 Mean :0.523 Mean :0.3816
## 3rd Qu.:38.00 3rd Qu.:1.000 3rd Qu.:0.0000
## Max. :80.00 Max. :8.000 Max. :6.0000
## NA's :177
## Fare Cabin Embarked
## Min. : 0.00 Length:891 : 2
## 1st Qu.: 7.91 Class :character C:168
## Median : 14.45 Mode :character Q: 77
## Mean : 32.20 S:644
## 3rd Qu.: 31.00
## Max. :512.33
##
결측치를 파악해보자. 결측치가 177개이며 컬럼별로 파악해보면 다음과 같다.
colSums(is.na(training_set))
## PassengerId Survived Pclass Name Sex Age
## 0 0 0 0 0 177
## SibSp Parch Ticket Fare Cabin Embarked
## 0 0 0 0 0 0
Age 결측치를 처리하는데 있어서 여러가지 방법이 있는데, 그 중 대표적인 것들이 NA제거, 평균값으로 대치, 행,열 제거가 있습니다. 이번에는 NA를 제거 하려고 하는데, 이유는 다음과 같다.
training_set <- training_set %>%
drop_na()
나이 데이터를 factor형식으로 10살 단위로 끊어 정제해보겠습니다. 60살이 넘으면 over60이라는 팩터를 구분을 지어놨습니다. 그리고 시각화를 하면, 어느정도 정규성을 띄는 것을 볼 수 있습니다.
training_set <- training_set %>%
mutate(Ages = case_when(
Age < 10 ~ "Under 10",
Age < 20 ~ "10 ~ 20",
Age < 30 ~ "20 ~ 30",
Age < 40 ~ "30 ~ 40",
Age < 50 ~ "40 ~ 50",
Age < 60 ~ "50 ~ 60",
TRUE ~ "over 60"
))
training_set$Ages <-
factor(training_set$Ages,
levels = c("Under 10", "10 ~ 20", "20 ~ 30", "30 ~ 40", "40 ~ 50", "50 ~ 60", "over 60"))
data_cleanging <- training_set %>%
group_by(Ages) %>%
summarise(Ages_count = n())
ggplot(data_cleanging, aes(x = Ages, y = Ages_count, fill=Ages)) +
geom_col() +
geom_text(aes(label=(Ages_count)), vjust=3, hjust = 0.5,color="black", size=4) +
theme(axis.text.x = element_text(size=10)) +
theme(axis.text.y = element_text(size=10))
타이타닉의 데이터를 시각화를 통해 파악해보겠습니다. 앞서 도메인 지식을 통해 어느정도는 남자와 여자가, 또는 객실의 등급에 따라서, 나이에 따라 생존 유무가 달라지는 것을 확인할 수 있었지만, 시각화를 통해 조금 더 직관적으로 알아보겠습니다.
성별에 따른 생존여부를 시각화해보겠습니다. 왼쪽 막대 그래프가 사망자의 남녀 분포이고, 오른쪽의 막대 그래프가 생존자의 막대 그래프입니다. 그래프만 봐도 알 수 있듯이, 사망자 중에서는 남자가 많은 비율을 차지하는것을 볼 수 있습니다.
ggplot_data<- ggplot(training_set, aes(x=Survived, fill = Sex)) +
geom_bar() +
ggtitle("성별에 따른 생존 여부") +
theme_bw()
ggplotly(ggplot_data, height = 500, width=800)
Pclass에 따른 생존여부에서 사망자의 수는 Pclass등급에 따라 어느정도 차이를 보이고 있으며, 왼쪽 생존자 막대 그래프에서는 등급에 따른 큰 차이를 보이지 않고 있습니다.
ggplot_data <- ggplot(training_set, aes(x = Survived, fill = Pclass)) +
geom_bar() +
ggtitle(" Pclass에 따른 생존 여부 ") +
theme_bw()
ggplotly(ggplot_data, height = 500, width = 800)
나이에 따른 생존여부를 확인하기위해 시각화를 한 자료에 근거하면, Under10과 over60에서 비교적 적은 사망자수를 확인할 수 있는 반면, 20~50대 사망자가 많은것으로 보아, 어린아이들과 노인들에 대한 선조치가 이루어졌을 것을 짐작할 수 있습니다.
ggplot_data <- training_set %>%
ggplot(aes(x = Survived, fill = Ages)) +
geom_bar() +
ggtitle(" 나이에 따른 생존 여부 ") +
theme_bw()
ggplotly(ggplot_data, height = 500, width = 800)
혼자 탑승한 승객의 사망자수가 가장 높게 나타났으나, 단순하게 1인 승객의 사망률이 높게 나타난것일 수 있으므로 유의미한 해석은 아닐 것 같습니다.
ggplot_data <- training_set %>%
ggplot(aes( x = Survived, fill = factor(SibSp))) +
geom_bar() +
ggtitle( "같이 탑승한 배우자 또는 형제에 따른 생존여부") +
theme_bw()
ggplotly(ggplot_data, height = 500, width = 800)
함께 탑승한 부모 또는 자녀의 수에 따른 생존여부를 시각해보았습니다. 예상했듯이 큰 의미는 없습니다.
ggplot_data <- training_set %>%
ggplot(aes( x = Survived, fill = factor(Parch))) +
geom_bar() +
ggtitle( "함께 탑승한 부모 또는 자녀의 수에 따른 생존여부") +
theme_bw()
ggplotly(ggplot_data, height = 500, width = 800)
데이터에 대한 파악, 자료형 변환을 마쳤고, 시각화까지 모두 학인해보았습니다. 이제 트레이닝 셋으로 모델을 만들어서 테스트 셋을 예측해보겠습니다. 종속변수는 Survived, 독립변수는 Sex와 Pclass, age로 하겠습니다. 그 전에 Survived의 자료형을 factor로 바꿔주겠습니다.
training_set$Survived <- as.factor(training_set$Survived)
str(training_set)
## 'data.frame': 714 obs. of 13 variables:
## $ PassengerId: int 1 2 3 4 5 7 8 9 10 11 ...
## $ Survived : Factor w/ 2 levels "0","1": 1 2 2 2 1 1 1 2 2 2 ...
## $ Pclass : Factor w/ 3 levels "1","2","3": 3 1 3 1 3 1 3 3 2 3 ...
## $ Name : chr "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
## $ Sex : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 1 1 1 ...
## $ Age : num 22 38 26 35 35 54 2 27 14 4 ...
## $ SibSp : int 1 1 0 1 0 0 3 0 1 1 ...
## $ Parch : int 0 0 0 0 0 0 1 2 0 1 ...
## $ Ticket : chr "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Cabin : chr "" "C85" "" "C123" ...
## $ Embarked : Factor w/ 4 levels "","C","Q","S": 4 2 4 4 4 4 4 4 2 4 ...
## $ Ages : Factor w/ 7 levels "Under 10","10 ~ 20",..: 3 4 3 4 4 6 1 3 2 1 ...
랜덤포레스트는 의사결정나무 모델의 상위버전이라고 할 수 있습니다. 여러개의 의사결정나무모델을 사용하여 정확도를 높이는 앙상블 기법 중 하나입니다.
# RandomForest 모델 생성
rf_m <- randomForest(Survived ~ Pclass + Age + Sex, data = training_set)
# importance
rf_info <- randomForest(Survived ~ Sex + Age + Pclass , data = training_set, importance = T)
# 데이터의 중요도 확인
importance(rf_info)
## 0 1 MeanDecreaseAccuracy MeanDecreaseGini
## Sex 42.36930 54.55962 50.81448 81.62365
## Age 16.70037 16.07127 23.31797 20.31608
## Pclass 23.94706 28.11527 29.32236 34.93814
#데이터의 중요도 시각화
varImpPlot(rf_info)
# test 결과 확인
rf_p <- predict(rf_m, newdata=test_set, type="class")
생성한 모델을 제출양식에 맞춰 Data Frame으로 제출해보겠습니다. 제출 양식은 처음에 다운받은 gender_submision.csv에서 확인할 수 있습니다. 그리고 제출한 결과 스코어는 다음과 같습니다. * Random Forest Score: 0.75598 두 모델 모두 73%, 75%로 비슷한 정확도를 보였지만, Random Forest의 결과가 조금 더 좋았습니다.
solution <- data.frame(PassengerID = test_set$PassengerId, Survived = rf_p)
write.csv(solution, "solution.csv", row.names = FALSE)
이렇게 캐글에서 타이타닉 생존자 예측을 시도했습니다. Pclass, Age, Sex 세 가지만 가지고 모델을 돌렸으며, 신뢰도는 70%정도가 나왔습니다. 조금 더 높힐 수 있는 방법으로는 test_set의 NA값을잘 처리하거나, Data 선정을 조금 더 잘 해야하는 방법이 있겠습니다.